(library (alist-utils)
  (export alist-refs
          alist-set
          alist-item-key
          alist-item-value
          alist-find-item-by-value
          alist-find-item-by-key
          alist?-shallow
          alist-any-key
          alist-any-value
          ;; alist-any-item
          )
  (import (rnrs base)
          (only (guile)
                lambda* λ
                ;; command line args
                program-arguments
                simple-format
                current-output-port
                ;; output
                display
                simple-format
                call-with-output-string)
          ;; GNU Guile batteries
          (ice-9 exceptions)
          (ice-9 textual-ports)
          ;; SRFIs
          ;; SRFI 1 - list procs
          (srfi srfi-1)
          ;; SRFI 43 - vector procs
          (srfi srfi-43)
          ;; SRFI 69 - hash tables
          (srfi srfi-69)
          (prefix (io) io:))

  (define rest cdr)

  (define alist-item-key
    (λ (item)
      "Get the key of the given ITEM of an alist."
      (first item)))

  (define alist-item-value
    (λ (item)
      "Get the value of the given ITEM of an alist."
      (cdr item)))

  (define alist-find-item-by-value
    (lambda* (val alst #:key (equal-test equal?))
      "Find an item of the given alist ALST by given value VAL
and return it."
      (find (λ (entry)
              (equal-test (cdr entry) val))
            alst)))

  (define alist-find-item-by-key
    (lambda* (key alst #:key (equal-test equal?))
      "Find an item of the given alist ALST by given key KEY
and return it."
      (find (λ (entry)
              (equal-test (first entry) key))
            alst)))

  (define alist-refs
    (lambda* (alist refs #:key (default-thunk #f) (equal-test equal?))
      ;; (simple-format (current-output-port) "remaining refs for alist: ~a\n" refs)
      (cond
       ;; If no more refs are given, we must have found what
       ;; we are looking for.
       [(null? refs) alist]
       [(pair? alist)
        (cond
         ;; If there are no more entries in the current alist,
         ;; then we could not find the searched key.
         [(null? alist)
          ;; If a default thunk was given, call it, otherwise
          ;; raise an exception.
          (if default-thunk
              (default-thunk)
              (raise-exception
               (make-exception (make-non-continuable-error)
                               (make-exception-with-message "key not found")
                               (make-exception-with-irritants (list refs alist))
                               (make-exception-with-origin 'alist-refs))))]
         [else
          (let ([ref (first refs)]
                [item (first alist)])
            (cond
             [(equal-test (alist-item-key item) ref)
              (alist-refs (alist-item-value item)
                          (cdr refs)
                          #:default-thunk default-thunk
                          #:equal-test equal-test)]
             [else
              (alist-refs (cdr alist)
                          refs
                          #:default-thunk default-thunk
                          #:equal-test equal-test)]))])]
       [else
        ;; (simple-format (current-output-port) "not a pair: ~a\n" alist)
        (if default-thunk
            (default-thunk)
            (raise-exception
             (make-exception (make-non-continuable-error)
                             (make-exception-with-message "key not found")
                             (make-exception-with-irritants (list refs alist))
                             (make-exception-with-origin 'alist-refs))))])))

  (define alist-set
    (lambda* (alst key val #:key (equal-test equal?))
      "Set a given value VAL for a given KEY in the given
association list ALST."
      (cond
       [(null? alst) (cons (cons key val) '())]
       [else
        (let ([current-assoc (first alst)])
          (cond
           [(equal-test (alist-item-key current-assoc) key)
            (cons (cons key val)
                  (rest alst))]
           [else
            (cons current-assoc
                  (alist-set (rest alst)
                             key
                             val
                             #:equal-test equal-test))]))])))

  (define alist?-shallow
    (λ (lst)
      "Check, whether LST is an association list, by only looking
at the first item."
      (cond
       [(null? lst) #t]
       [(pair? lst)
        (pair? (first lst))]
       [else #f])))

  (define alist-any-key
    (lambda* (alst pred)
      "Check, whether any key in the alist ALST satisfies the
given predicate PRED."
      (cond
       [(null? alst) #f]
       [else
        (let ([first-key (alist-item-key (first alst))]
              [first-val (alist-item-value (first alst))])
          (cond
           ;; Check the predicate for the first key.
           [(pred first-key) #t]
           ;; If the first value seems to be an association
           ;; list itself, then check it and the rest of the
           ;; alist keys at the current level.
           [(alist?-shallow first-val)
            (or (alist-any-key first-val pred)
                (alist-any-key (drop alst 1) pred))]
           [else
            ;; Check the rest of the keys of the association
            ;; list.
            (alist-any-key (drop alst 1) pred)]))])))

  (define alist-any-value
    (λ (alst pred)
      "Check, whether any value in the alist ALST satisfies the
given predicate PRED."
      (cond
       [(null? alst) #f]
       [else
        (let ([first-val (alist-item-value (first alst))])
          (cond
           [(pred first-val) #t]
           [(alist?-shallow first-val)
            (or (alist-any-value first-val pred)
                (alist-any-value (drop alst 1) pred))]
           [else
            (alist-any-value (drop alst 1) pred)]))])))

  ;; (define alist-any-item
;;     (λ (alst pred)
;;       "Check, whether any key value pair in the alist ALST
;; satisfies the given predicate PRED."
;;       (cond
;;        [(null? alst) #f]
;;        [(alist?-shallow alst)
;;         (let ([first-key (alist-item-key (first alst))]
;;               [first-val (alist-item-value (first alst))])
;;           (cond
;;            [(pred first-key first-val) #t]
;;            [(alist?-shallow first-val)
;;             (or (alist-any-item first-val pred)
;;                 (alist-any-item (drop alst 1) pred))]
;;            [else
;;             (alist-any-item (drop alst 1) pred)]))]
;;        [else
;;         #f
;;         #;(raise-exception
;;          (make-exception (make-non-continuable-error)
;;                          (make-exception-with-message "not an association list")
;;                          (make-exception-with-irritants (list alst))
;;                          (make-exception-with-origin 'alist-any-item)))])))
  )
